home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / ss / anlytc_1.zip / GRF.BAS < prev    next >
BASIC Source File  |  1985-09-25  |  26KB  |  581 lines
  1. 10 '
  2. 20 ' This is a demo program which (in conjunction with the PCDOS GRAPHICS
  3. 30 ' utility for hard copy) generates line graphs. Up to 5 graphs with
  4. 40 ' different symbols may be plotted on the same plot. The program can
  5. 50 ' read numerically saved AnalytiCalc spreadsheets or its own saved
  6. 60 ' format files. When using, the function keys usually need a <return>
  7. 70 ' after them to get them to be acted on. BASICA of PCDOS 2.0 or later
  8. 80 ' is required. If it bombs, check to see the screen limits of display
  9. 90 ' make sense. Logs of negative numbers may result if the screen is set
  10. 100 'up for linear display; reset the limits. Everything is pretty much
  11. 110 ' menu driven and works adequately. Note however this is a demo and
  12. 120 ' you may modify it to your needs as you like. The linear regression
  13. 130 ' option allows you to fit a line to a data set and tell how good a
  14. 140 ' fit it is. Finally, a one-dimensional plot is a histogram. A two
  15. 150 ' dimensional plot is a scatterplot. You need to enter spreadsheet
  16. 160 ' coordinate limits numerically for plots, so column A is 1, B is 2,
  17. 170 ' and so on. You can work with up to 5 sets of up to 100 points at
  18. 180 ' a time. Color display is used, so change if you have a problem.
  19. 680 '-----------------------------------------------------------
  20. 690 '
  21. 700 DIM X(100),Y(100),X1(100),Y1(100)
  22. 710 DIM XX(5,100),YY(5,100)
  23. 720 DIM LTYPESET(5),SIZESET(5),SYMSET(5),NPTSET(5)
  24. 730 DIM SYM$(10),LTYPE$(5),CORNER$(4)
  25. 740 '
  26. 750 ON ERROR GOTO 3770
  27. 760 KEY OFF:WIDTH 80
  28. 770 ON KEY (1) GOSUB 3780
  29. 780 ON KEY (2) GOSUB 3790
  30. 790 ON KEY (3) GOSUB 3850
  31. 800 ON KEY (4) GOSUB 3880
  32. 810 ON KEY (5) GOSUB 3910
  33. 820 ON KEY (6) GOSUB 3930
  34. 830 ON KEY (7) GOSUB 3950
  35. 840 ON KEY (8) GOSUB 3970
  36. 850 ON KEY (9) GOSUB 3990
  37. 860 ON KEY (10) GOSUB 4010
  38. 870 ON KEY (11) GOSUB 4030
  39. 880 KEY (1) ON:KEY (2) ON:KEY (3) ON:KEY (4) ON:KEY (5) ON
  40. 890 KEY (6) ON:KEY (7) ON:KEY (8) ON:KEY (9) ON:KEY (10) ON
  41. 900 KEY (11) ON
  42. 910 SCREEN 0:CLS:COLOR 13,0,1:LOCATE 5,18:
  43. 920 PRINT "GRAPH a general plotting program"
  44. 930 X$=STRING$(70,205)
  45. 940 COLOR 12,0,1:LOCATE 2,6:PRINT X$;
  46. 950 SYM$(0)="none":SYM$(1)="open square":SYM$(3)="open triangle":SYM$(5)="open circle"
  47. 960 SYM$(9)="X":SYM$(7)="open diamond":SYM$(2)="filled square":SYM$(4)="filled triangle":SYM$(6)="filled circle":SYM$(8)="filled diamond"
  48. 970 LTYPE$(0)="none":LTYPE$(1)="solid":LTYPE$(2)="dashed":LTYPE$(3)="dotted"
  49. 980 CORNER$(0)="none":CORNER$(1)="lower left":CORNER$(2)="upper left"
  50. 990 CORNER$(3)="lower right":CORNER$(4)="upper right"
  51. 1000 DATASET=1
  52. 1010 HELP=1
  53. 1020 LTYPE$(4)="regression"
  54. 1030 XMIN=.1:XMAX=99:XLIN=0:XLEN=7
  55. 1040 YMIN=.1:YMAX=99:YLIN=0:YLEN=5.5
  56. 1050 FOR I=1 TO 5
  57. 1060 SIZESET(I)=1.5:LTYPESET(I)=1
  58. 1070 SYMSET(I)=I
  59. 1080 NEXT I
  60. 1090 LOCATE 23,6:PRINT X$;
  61. 1100 LOCATE 2,5:PRINT CHR$(201);:LOCATE 2,75:PRINT CHR$(187);
  62. 1110 LOCATE 23,5:PRINT CHR$(200);:LOCATE 23,75:PRINT CHR$(188);
  63. 1120 FOR I=1 TO 20:LOCATE 2+I,5:PRINT CHR$(186);:NEXT I
  64. 1130 FOR I=1 TO 20:LOCATE 2+I,75:PRINT CHR$(186);:NEXT I
  65. 1140 COLOR 13,0,1:LOCATE 10,25:PRINT "Version 2.2";:LOCATE 20,28:PRINT "Hit any key to start"
  66. 1150 LOCATE 24,1
  67. 1160 A$=INKEY$:IF A$="" THEN 1160
  68. 1170 '
  69. 1180 '  now display menu of plot specifications
  70. 1190 '
  71. 1200 SCREEN 0:COLOR 1,0,0:CLS:SCREEN 0:CLS:COLOR 15,1,1:PRINT "GRAPH  2.2"
  72. 1210 PRINT STRING$(80,205);
  73. 1220 IF DATASET<1 OR DATASET>5 THEN 1240
  74. 1230 SYM=SYMSET(DATASET):SIZE=SIZESET(DATASET):LTYPE=LTYPESET(DATASET)
  75. 1240 COLOR 13,0,1:PRINT "Plot specification parameters:"
  76. 1250 PRINT "    1. Symbol Type : ";SYM$(SYMSET(DATASET))
  77. 1260 PRINT "    2. Symbol size is ";SIZESET(DATASET);" % of axis length"
  78. 1270 PRINT "    3. Line type : ";LTYPE$(LTYPESET(DATASET))
  79. 1280 PRINT "    4. Label line 1 :";LAB1$
  80. 1290 PRINT "    5. Label line 2 :";LAB2$
  81. 1300 PRINT "    6. Label line 3 :";LAB3$
  82. 1310 PRINT "    7. Corner for label : ";CORNER$(CORNER)
  83. 1320 PRINT "    8. Working on data set : ";DATASET
  84. 1330 COLOR 10,0,1:PRINT "X axis parameters:"
  85. 1340 PRINT "    9. X axis length =";XLEN;" inches"
  86. 1350 PRINT "   10. Minimum value =";XMIN
  87. 1360 PRINT "   11. Maximum value =";XMAX
  88. 1370 IF XLIN=0 THEN PRINT "   12. Linear X axis"
  89. 1380 IF XLIN=1 THEN PRINT "   12. Logarithmic X axis"
  90. 1390 PRINT "   13. X axis label :";XLAB$
  91. 1400 COLOR 12,0,1:PRINT "Y axis parameters :"
  92. 1410 PRINT "   14. Y axis length =";YLEN;" inches"
  93. 1420 PRINT "   15. Minimum value =";YMIN
  94. 1430 PRINT "   16. Maximum value =";YMAX
  95. 1440 IF YLIN=0 THEN PRINT "   17. Linear Y axis"
  96. 1450 IF YLIN=1 THEN PRINT "   17. Logarithmic Y axis"
  97. 1460 PRINT "   18. Y axis label :";YLAB$
  98. 1470 IF HELP=1 THEN GOSUB 4050         'help menu display
  99. 1480 LOCATE 25,2:COLOR 14,0,1:INPUT "Change number (0=none) :";CHNG
  100. 1490 IF CHNG=0 THEN 2780
  101. 1500 ON CHNG GOTO 1520,1710,1550,1560,1570,1580,1590,1700,1600,1610,1620,1630,1640,1650,1660,1670,1680,1690
  102. 1510 GOTO 1200
  103. 1520 PRINT "Symbol type (0=none,1=open sq,2=fill sq,3=open tri,4=fill tri"
  104. 1530 INPUT "     5=open cir,6=fill cir,7=open diam,8=fill diam,9=X) :";SYM
  105. 1540 SYMSET(DATASET)=SYM:GOTO 1200
  106. 1550 INPUT "Line type (0=none,1=solid,2=dashed,3=dotted,4=regression) :";LTYPE:LTYPESET(DATASET)=LTYPE:GOTO 1200
  107. 1560 INPUT "Label line 1 :";LAB1$:GOTO 1200
  108. 1570 INPUT "label line 2 :";LAB2$:GOTO 1200
  109. 1580 INPUT "Label line 3 :";LAB3$:GOTO 1200
  110. 1590 INPUT "corner for label (0=none,1=LL,2=UL,3=LR,4=UR) :";CORNER:GOTO 1170
  111. 1600 INPUT "Length of X axis in inches :";XLEN:GOTO 1200
  112. 1610 INPUT "Minimum X value :";XMIN:GOTO 1200
  113. 1620 INPUT "maximum X value :";XMAX:GOTO 1200
  114. 1630 XLIN=1-XLIN:GOTO 1200
  115. 1640 INPUT "X axis label :";XLAB$:GOTO 1200
  116. 1650 INPUT "Length of Y axis in inches :";YLEN:GOTO 1200
  117. 1660 INPUT "Minimum Y value :";YMIN:GOTO 1200
  118. 1670 INPUT "Maximum Y value :";YMAX:GOTO 1200
  119. 1680 YLIN=1-YLIN:GOTO 1200
  120. 1690 INPUT "Y axis label :";YLAB$:GOTO 1200
  121. 1700 INPUT "Number of data set to edit (1-5) :";DATASET:GOTO 1200
  122. 1710 INPUT "Symbol size (% of axes length) ";SIZE:SIZESET(DATASET)=SIZE:GOTO 1200
  123. 1720 '
  124. 1730 '  Read in data from disk file
  125. 1740 '
  126. 1750 CLS:COLOR 0,7,1:PRINT :LOCATE 2,20:PRINT "  READ DATA IN FROM DISK FILE  ":PRINT :COLOR 14,0,1
  127. 1760 PRINT "Files on this disk :":PRINT
  128. 1770 FILES
  129. 1780 PRINT
  130. 1790 INPUT "Name of input data file ";DATAIN$:IF DATAIN$="" THEN 1790
  131. 1800 INPUT "AnalytiCalc Save File (A) or Data File (D)";ND$
  132. 1810 ND$=LEFT$(ND$,1)
  133. 1820 NSV=1:IF ND$ = "A" THEN INPUT "Enter saveset number 1-5>";NSV
  134. 1830 IF ND$ <> "A" THEN GOTO 1920
  135. 1840 NXL=1:NXH=18000:NYL=1:NYH=18000:INPUT "1 OR 2 DIMENSION PLOT";NDM
  136. 1850 INPUT "Enter low, high range for Y axis spreadsheet COLS";NYL,NYH
  137. 1860 INPUT "Enter low, high range for Y axis spreadsheet ROWS";NXL,NXH
  138. 1870 IF NDM < 2 THEN GOTO 1920
  139. 1880 INPUT "Enter low, high range for X axis spreadsheet COLS";MYL,MYH
  140. 1890 INPUT "Enter low, high range for X axis spreadsheet ROWS";MXL,MXH
  141. 1900 ' NOW LIMIT INPUT TO THESE RANGES.
  142. 1910 '
  143. 1920 DATASET=NSV
  144. 1930 IF ND$ = "A" THEN GOTO 2040
  145. 1940 'DATAIN$=DATAIN$+".dta"
  146. 1950 OPEN DATAIN$ FOR INPUT AS #1
  147. 1960 FOR I=1 TO 5
  148. 1970    INPUT #1,NPTSET(I),SYMSET(I),SIZESET(I),LTYPESET(I)
  149. 1980            FOR J=1 TO NPTSET(I)
  150. 1990            INPUT #1,XX(I,J),YY(I,J)
  151. 2000            NEXT J
  152. 2010 NEXT I
  153. 2020 CLOSE #1
  154. 2030 GOTO 2970
  155. 2040 ' ANALYTICALC INPUT FILES... INPUT AND ASSUME ONLY ONE ROW OR COLUMN THERE.
  156. 2050 NPT=0:ON ERROR GOTO 2330
  157. 2060 OPEN DATAIN$ FOR INPUT AS #1
  158. 2070 LINE INPUT #1,T$
  159. 2080 INPUT #1,I1$,I2
  160. 2090 LINE INPUT #1,L$
  161. 2100 INPUT #1,TP,F$,TY
  162. 2110 ' I1$ IS PNN, NN=ONE OFFSET, AND I2 IS OTHER OFFSET FOR SAVE CELL NO.
  163. 2120 I1=VAL(RIGHT$(I1$,5))
  164. 2130 IF TP <= 0 AND NPT < 100 THEN GOTO 2080
  165. 2140 ' SKIP LABEL RECORDS
  166. 2150 IF I1 < NYL OR I1 > NYH THEN GOTO 2080
  167. 2160 IF I2 < NXL OR I2 > NXH THEN GOTO 2080
  168. 2170 YV=VAL(L$):XV=NPT
  169. 2180 IF NDM = 1 THEN GOTO 2220
  170. 2190 IF I1 < MYL OR I1 > MYH THEN GOTO 2080
  171. 2200 IF I2 < MXL OR I2 > MXH THEN GOTO 2080
  172. 2210 XV=VAL(L$)
  173. 2220 IF NPT=100 THEN PRINT "Max 100 points reached":GOTO 2330
  174. 2230 ' HERE HAVE VALUES TO PLOT, SO INSERT INTO ARRAY.
  175. 2280 NPT=NPT+1:XX(NSV,NPT)=XV:YY(NSV,NPT)=YV
  176. 2320 GOTO 2080
  177. 2330 NPTSET(NSV)=NPT
  178. 2340 CLOSE #1
  179. 2350 GOTO 2970
  180. 2360 '
  181. 2370 '  Write out data to disk file
  182. 2380 '
  183. 2390 CLS:COLOR 0,7,1:PRINT :LOCATE 2,20:PRINT "  WRITE CURRENT DATA OUT TO DISK FILE  ":PRINT:COLOR 14,0,1
  184. 2400 PRINT "Files on this disk:":PRINT
  185. 2410 FILES
  186. 2420 INPUT "Name of output data file ";DATAOUT$:IF DATAOUT$="" THEN 2420
  187. 2430 DATAOUT$=DATAOUT$+".dta"
  188. 2440 OPEN DATAOUT$ FOR OUTPUT AS #1
  189. 2450 FOR I=1 TO 5
  190. 2460 WRITE #1,NPTSET(I),SYMSET(I),SIZESET(I),LTYPESET(I)
  191. 2470    FOR J=1 TO NPTSET(I)
  192. 2480    WRITE #1,XX(I,J),YY(I,J)
  193. 2490    NEXT J
  194. 2500 NEXT I
  195. 2510 CLOSE #1
  196. 2520 GOTO 2970
  197. 2530 '
  198. 2540 '  read in plot specs from disk file
  199. 2550 '
  200. 2560 CLS:COLOR 0,7,1:PRINT :LOCATE 2,15:PRINT "  READ IN PLOT SPECIFICATIONS FROM DISK FILE  ":PRINT :COLOR 14,0,1
  201. 2570 PRINT "Specification files on this disk:":PRINT
  202. 2580 FILES"*.spc
  203. 2590 INPUT "Name of file with plot specifications ";PLOTSPEC$
  204. 2600 IF PLOTSPEC$="" THEN 2590
  205. 2610 PLOTSPEC$=PLOTSPEC$+".spc"
  206. 2620 OPEN PLOTSPEC$ FOR INPUT AS #1
  207. 2630 INPUT #1,SYM,SIZE,LTYPE,XLEN,XMIN,XMAX,XLIN,XINC,XLAB$,YLEN,YMIN,YMAX,YLIN,YLAB$,LAB1$,LAB2$,LAB3$,CORNER
  208. 2640 CLOSE #1
  209. 2650 GOTO 1200
  210. 2660 '
  211. 2670 '  write out current plot specs to disk file for future use
  212. 2680 '
  213. 2690 CLS:COLOR 0,7,1:PRINT :LOCATE 2,15:PRINT "  WRITE CURRENT PLOT SPECIFICATIONS OUT TO DISK FILE  ":PRINT :COLOR 14,0,1
  214. 2700 PRINT " Specification files on this disk :":PRINT
  215. 2710 FILES"*.spc
  216. 2720 INPUT "Name of disk file for plot specifications output ";OUTSPEC$
  217. 2730 OUTSPEC$=OUTSPEC$+".spc"
  218. 2740 OPEN OUTSPEC$ FOR OUTPUT AS #1
  219. 2750 WRITE #1,SYM,SIZE,LTYPE,XLEN,XMIN,XMAX,XLIN,XINC,XLAB$,YLEN,YMIN,YMAX,YLIN,YLAB$,LAB1$,LAB2$,LAB3$,CORNER
  220. 2760 CLOSE #1
  221. 2770 GOTO 1200
  222. 2780 '
  223. 2790 '  Input data and allow editing
  224. 2800 '
  225. 2810 IF NPTSET(DATASET)>=1 THEN 2970
  226. 2820 COLOR 1,0,0:CLS:SCREEN 0:CLS:IF HELP=1 THEN GOSUB 4050
  227. 2830 LOCATE 23,1:PRINT "Data Set  ";DATASET:INPUT "How many data points :",NPTS
  228. 2840 IF NPTS=0 THEN 3510
  229. 2850 NPTSET(DATASET)=NPTS
  230. 2860 IF NPTS=-1 THEN GOTO 1730
  231. 2870 IF NPTS<-1 THEN 2790
  232. 2880 PRINT "Data Set Number ";DATASET
  233. 2890 FOR I=1 TO NPTS
  234. 2900    COLOR 10,0,1:PRINT I;".  ";:INPUT "X value ";XX(DATASET,I)
  235. 2910    COLOR 12,0,1:INPUT "      Y value ";YY(DATASET,I)
  236. 2920    PRINT
  237. 2930 NEXT I
  238. 2940 '
  239. 2950 '  Display data for editing
  240. 2960 '
  241. 2970 CLS:SCREEN 0:COLOR 15,1,1
  242. 2980 IF NPTSET(DATASET)<1 THEN GOTO 2830
  243. 2990 PRINT " I    X(I)   Y(I)";:PRINT STRING$(63,32);
  244. 3000 X$=STRING$(80,205):PRINT X$
  245. 3010 SX=0:SY=0:SSX=0:SXY=0
  246. 3020 NPTS=NPTSET(DATASET)
  247. 3030 IF HELP=1 THEN GOSUB 4050                 'help menu display
  248. 3040 FOR I=1 TO NPTSET(DATASET)
  249. 3050    LOCATE ((I-1) MOD 20)+3,1+(18*FIX((I-1)/20)):COLOR 14,0,1:PRINT I;".";
  250. 3060    LOCATE ((I-1) MOD 20)+3,8+(18*FIX((I-1)/20)):COLOR 10,0,1:PRINT XX(DATASET,I);
  251. 3070    LOCATE ((I-1) MOD 20)+3,14+(18*FIX((I-1)/20)):COLOR 12,0,1:PRINT YY(DATASET,I);
  252. 3080 IF LTYPESET(DATASET)<>4 THEN 3120
  253. 3090 XTEMP=XX(DATASET,I):YTEMP=YY(DATASET,I):IF XLIN=1 THEN XTEMP=LOG(XX(DATASET,I))/LOG(10)
  254. 3100 IF YLIN=1 THEN YTEMP=LOG(YY(DATASET,I))/LOG(10)
  255. 3110 SX=SX+XTEMP:SY=SY+YTEMP:SSX=SSX+(XTEMP^2):SXY=SXY+(XTEMP*YTEMP)
  256. 3120 NEXT I
  257. 3130 IF LTYPESET(DATASET)<>4 THEN 3230
  258. 3140 A=((NPTS*SXY)-(SX*SY))/((NPTS*SSX)-(SX*SX))
  259. 3150 B=(SY/NPTS)-(A*SX/NPTS):SD=0
  260. 3160 FOR I=1 TO NPTS
  261. 3170 XTEMP=XX(DATASET,I):IF XLIN=1 THEN XTEMP=LOG(XX(DATASET,I))/LOG(10)
  262. 3180 YTEMP=YY(DATASET,I):IF YLIN=1 THEN YTEMP=LOG(YY(DATASET,I))/LOG(10)
  263. 3190 SD=SD+((YTEMP-((A*XTEMP)+B))^2)
  264. 3200 SD=SD+((YTEMP-((A*XTEMP)+B))^2)
  265. 3210 NEXT I
  266. 3220 SD=SQR(SD)/NPTS
  267. 3230 COLOR 10,0,1:LOCATE 23,2:PRINT "Data set ";DATASET;"   Symbol : ";SYM$(SYMSET(DATASET));"   Size : ";SIZESET(DATASET);"%   Line type : ";LTYPE$(LTYPESET(DATASET));
  268. 3240 LGX$="   ":IF XLIN=1 THEN LGX$="log"
  269. 3250 LGY$="   ":IF YLIN=1 THEN LGY$="log"
  270. 3260 IF LTYPESET(DATASET)=4 THEN COLOR 13,0,1:LOCATE 24,2:PRINT "Regression :";LGY$;" Y = ";:PRINT USING "#####.###";A;:PRINT " *";LGX$;" X + ";:PRINT USING "#####.###";B;:PRINT "     avg dev = ";:PRINT USING "####.###";SD;
  271. 3270 COLOR 14,0,1
  272. 3280 LOCATE 25,2:INPUT  "Change number (0 for none,-1 for sort) :";CHNG
  273. 3290 CLS:IF CHNG=0 THEN GOTO 3510
  274. 3300 IF CHNG>0 THEN 3440
  275. 3310 '
  276. 3320 '  Sort the data
  277. 3330 '
  278. 3340 LOCATE 12,30:PRINT "Sorting ...."
  279. 3350 FOR I=1 TO NPTS
  280. 3360    FOR J=1 TO NPTS
  281. 3370            IF XX(DATASET,J)>XX(DATASET,I) THEN TEMP=XX(DATASET,J):XX(DATASET,J)=XX(DATASET,I):XX(DATASET,I)=TEMP:TEMP=YY(DATASET,J):YY(DATASET,J)=YY(DATASET,I):YY(DATASET,I)=TEMP
  282. 3380    NEXT J
  283. 3390 NEXT I
  284. 3400 GOTO 2970
  285. 3410 '
  286. 3420 '  Get new value for data point
  287. 3430 '
  288. 3440 IF CHNG>NPTS THEN NPTSET(DATASET)=NPTSET(DATASET)+1:CHNG=NPTSET(DATASET)
  289. 3450 PRINT "Input new values for point ";CHNG
  290. 3460 PRINT :PRINT :INPUT "X value ";XX(DATASET,CHNG)
  291. 3470 INPUT "Y value ";YY(DATASET,CHNG)
  292. 3480 GOTO 2970
  293. 3490 '
  294. 3500 '
  295. 3510 '  Now go to subplot subroutine to plot
  296. 3520 '
  297. 3530 KLR=15
  298. 3540 FOR DSET=1 TO 5
  299. 3550    I=DSET
  300. 3560    SYM=SYMSET(I)
  301. 3570    SIZE=SIZESET(I)
  302. 3580    LTYPE=LTYPESET(I)
  303. 3590    NPTS=NPTSET(I)
  304. 3600    FOR J=1 TO NPTSET(I)
  305. 3610            X(J)=XX(I,J):Y(J)=YY(I,J)
  306. 3620    NEXT J
  307. 3630    MORE=0
  308. 3640    IF I>1 THEN MORE=1
  309. 3650    GOSUB 4290
  310. 3660 NEXT DSET
  311. 3670 '
  312. 3680 '  display graph until any key pressed (including function keys)
  313. 3690 '
  314. 3700 A$=INKEY$:IF A$="" THEN 3700 ELSE 1200
  315. 3710 '
  316. 3720 '
  317. 3730 ' This section contains subroutines executed on errors
  318. 3740 ' and on key traps.
  319. 3750 '
  320. 3760 '
  321. 3770 IF ERR=5 OR ERR=53 THEN RESUME NEXT ELSE ON ERROR GOTO 0
  322. 3780 RETURN 3510 'f1 - plot data
  323. 3790 'exit program - return to DOS
  324. 3800 PRINT :PRINT "WARNING ! You will lose any unsaved data if you exit !"
  325. 3810 PRINT "   do you really want to exit (y or n) ? ";
  326. 3820 A$=INKEY$:IF A$="" THEN 3820
  327. 3830 IF A$="n" OR A$="N" THEN 1180 ELSE SYSTEM
  328. 3840 'f2 - exit program - return to DOS
  329. 3850 DATASET=DATASET-1:IF DATASET<1 THEN DATASET=1:BEEP
  330. 3860 ' f3  - decrease data set number by one
  331. 3870 RETURN 2810
  332. 3880 'f4 - Next data set
  333. 3890 DATASET=DATASET+1:IF DATASET>5 THEN DATASET=5:BEEP
  334. 3900 RETURN 2810
  335. 3910 'f5 - load specifications from file
  336. 3920 RETURN 2540
  337. 3930 'f6 - save specifications in file
  338. 3940 RETURN 2680
  339. 3950 'f7 - load data from file
  340. 3960 RETURN 1730
  341. 3970 'f8 - save data in file
  342. 3980 RETURN 2370
  343. 3990 'f9 - go to specifications menu
  344. 4000 RETURN 1180
  345. 4010 'f10 - go to data display for current data set
  346. 4020 RETURN 2810
  347. 4030 ' <up cursor> key - help screen toggle
  348. 4040 HELP=1-HELP:RETURN
  349. 4050 '
  350. 4060 '  help menu display
  351. 4070 '
  352. 4080 COLOR 15,1,1
  353. 4090 LOCATE 1,58:PRINT "      FUNCTION KEYS    ";
  354. 4100 LOCATE 2,58:PRINT "                       ";
  355. 4110 X$=STRING$(19,196)
  356. 4120 LOCATE 4,58:PRINT "     PLOT     EXIT TO  ";
  357. 4130 LOCATE 5,58:PRINT "     FIGURE     DOS    ";
  358. 4140 LOCATE 7,58:PRINT "     DECR       INCR   ";
  359. 4150 LOCATE 8,58:PRINT "    DATASET   DATASET  ";
  360. 4160 LOCATE 10,58:PRINT "   LOAD SPEC SAVE SPEC ";
  361. 4170 LOCATE 11,58:PRINT "      FILE      FILE   ";
  362. 4180 LOCATE 13,58:PRINT "   LOAD DATA SAVE DATA ";
  363. 4190 LOCATE 14,58:PRINT "      FILE      FILE   ";
  364. 4200 LOCATE 16,58:PRINT "      SPEC      DATA   ";
  365. 4210 LOCATE 17,58:PRINT "      MENU      MENU   ";
  366. 4220 LOCATE 20,58:PRINT "<up cursor>=help toggle";
  367. 4230 LOCATE 19,58:PRINT "Alt-C = Color Increment";
  368. 4240 LOCATE 3,58:PRINT "  "+CHR$(218)+X$+CHR$(191);
  369. 4250 FOR I.H=6 TO 15 STEP 3:LOCATE I.H,58:PRINT "   "+X$+" ";:NEXT
  370. 4260 LOCATE 18,58:PRINT "  "+CHR$(192)+X$+CHR$(217);
  371. 4270 FOR I.C=60 TO 80 STEP 10:FOR I.R=4 TO 17:LOCATE I.R,I.C:PRINT CHR$(179);:NEXT :NEXT
  372. 4280 RETURN
  373. 4290 ' graphics display routine. Plots data and draws grid.
  374. 4380 '
  375. 4390 ' Alt-C controls the color of the plot, the entire figure is
  376. 4400 ' plotted in the chosen color. The color option does not
  377. 4410 ' affect the printer dump print density.
  378. 4420 '---------------------------------------------------------------
  379. 4430 'Calling sequence:
  380. 4470 '         gosub 4290 at point where you want the plot
  381. 4500 'Parameters:    Do not use these names elsewhere in your program
  382. 4510 '
  383. 4520 ' SYM             symbol type (0=none,1=open sq,2=fill sq,3=open tri
  384. 4530 '                         4=fill tri,5=open cir,6=fill cir
  385. 4540 '                         7=open diamond,8=filled diamond,9=X
  386. 4550 ' SIZE            Symbol size in % of axes length
  387. 4560 ' LTYPE           line type (0=none,1=solid,2=dashed,3=dotted,4=regressio
  388. 4570 ' NPTS            is the number of data points
  389. 4580 ' X(I),Y(I)       arrays that contain the x and y data points
  390. 4590 ' XLEN,YLEN       x and y axis length in inches
  391. 4600 ' XMIN,YMIN       x any y minimum values
  392. 4610 ' XMAX,YMAX       x and y axis maximum values
  393. 4620 ' XLIN,YLIN       flag for linear(=0) or Log(=1) axis
  394. 4630 ' XINC,YINC       unit increment on each axis (valid only for linear)
  395. 4640 '                  if these are <=0 they are calculated from data
  396. 4650 ' XLAB$,YLAB$     strings containing the axis labels
  397. 4660 ' LAB1$,LAB2$,LAB3$       three label lines
  398. 4670 ' CORNER          specifies the corner for the label
  399. 4680 '                 (0=none,1=LL,2=LR,3=UL,4=UR)
  400. 4690 '  MORE            a flag that indicates whether this call is the
  401. 4700 '                  first and so axes should be plotted, or if it
  402. 4710 '                  is more data to go on the same axes (axes are
  403. 4720 '                  not plotted if MORE=1), MORE=0 new figure.
  404. 4730 '
  405. 4740 ' For more than one set of data on the same axes:
  406. 4750 '         1. Set up the first set of data and all other plot parameters
  407. 4760 '         2. GOSUB 4290 with MORE=0
  408. 4770 '         3. Set up second set of data (leave plot parameters unchanged)
  409. 4780 '                 (you may change SYM, SIZE, LTYPE and NPTS for each set)
  410. 4790 '         4. GOSUB 4290 with MORE=1
  411. 4800 '         5. repeat steps 3 and 4 for each additional data set
  412. 4810 '
  413. 4820 '----------------------------------------------------------------
  414. 4830 '
  415. 4840 '
  416. 4850 ' Scale axes and plot them
  417. 4860 '
  418. 4870   IF YLEN<=0 THEN YLEN=5.5
  419. 4880   IF XLEN<=0 THEN XLEN=7.5
  420. 4890   IF MORE<>1 THEN SCREEN 2:CLS:KEY OFF
  421. 4900 KEY 20,CHR$(&H8)+CHR$(46):KEY (20) ON
  422. 4910 ON KEY (20) GOSUB 6430
  423. 4920 IF KLR.P=0 THEN KLR.P=15
  424. 4930 OUT 985,KLR.P
  425. 4940   XINC.P=XINC:YINC.P=YINC
  426. 4950   XRANGE.P=XMAX-XMIN:YRANGE.P=YMAX-YMIN
  427. 4960 IF XINC<=0 THEN XINC.P=10^(INT(LOG(XRANGE.P*.66)/LOG(10)))
  428. 4970 IF YINC<=0 THEN YINC.P=10^(INT(LOG(YRANGE.P*.66)/LOG(10)))
  429. 4980   XMIN.P=XINC.P*INT(XMIN/XINC.P):XMAX.P=XINC.P*(INT((XMAX/XINC.P)+1))
  430. 4990   YMAX.P=YINC.P*INT((YMAX/YINC.P)+1):YMIN.P=YINC.P*(INT(YMIN/YINC.P))
  431. 5000 IF XLIN=1 THEN XMAX.P=LOG(XMAX)/LOG(10):XMIN.P=LOG(XMIN)/LOG(10)
  432. 5010 IF YLIN=1 THEN YMAX.P=LOG(YMAX)/LOG(10):YMIN.P=LOG(YMIN)/LOG(10)
  433. 5020   XRANGE.P=XMAX.P-XMIN.P:YRANGE.P=YMAX.P-YMIN.P
  434. 5030  DX=SIZE*XRANGE.P/100!:DY=SIZE*YRANGE.P/100!
  435. 5040   XT.P=XRANGE.P*(9!/XLEN):YT.P=YRANGE.P*(7!/YLEN)
  436. 5050   TICX=.03*XRANGE.P:TICY=.04*YRANGE.P
  437. 5060 XTRA=(XT.P-XRANGE.P)*9/XT.P:YTRA=(YT.P-YRANGE.P)*7/YT.P
  438. 5070   LBD.X=XMIN.P-(1!*XT.P/9)
  439. 5080   LBD.Y=YMIN.P-(1!*YT.P/7)
  440. 5090   UBD.X=XMAX.P+((XTRA-1!)*XT.P/9):UBD.Y=YMAX.P+((YTRA-1!)*YT.P/7)
  441. 5100   IF MORE<>1 THEN WINDOW (LBD.X,LBD.Y)-(UBD.X,UBD.Y)
  442. 5110   IF MORE<>1 THEN LINE (XMIN.P,YMIN.P)-(XMAX.P,YMAX.P),1,B
  443. 5120 XLOW.P=XMIN.P-LBD.X:YLOW.P=YMIN.P-LBD.Y
  444. 5130 XHI.P=XT.P-XRANGE.P-XLOW.P:YHI.P=YT.P-YRANGE.P-YLOW.P
  445. 5140   XP.P=.00161*(UBD.X-LBD.X)
  446. 5150   IF MORE<>1 THEN LINE (XMIN.P+XP.P,YMIN.P)-(XMAX.P+XP.P,YMAX.P),1,B
  447. 5160 STYLE=&HFFFF:IF LTYPE=0 THEN STYLE=&H0
  448. 5170 IF LTYPE=2 THEN STYLE=&HF0F0
  449. 5180 IF LTYPE=3 THEN STYLE=&HC0C0
  450. 5190 IF LTYPE=4 THEN STYLE=&H0
  451. 5200 IF MORE=1 THEN 6140
  452. 5210 '
  453. 5220   'label axes
  454. 5230 '
  455. 5240 XPOS.P=((XLOW.P+(XRANGE.P/2!))*80!/XT.P)-(LEN(XLAB$)/2)
  456. 5250 LOCATE 25,XPOS.P:PRINT XLAB$;
  457. 5260 YPOS.P=25!-(25!*((YLOW.P+(YRANGE.P/2!))/YT.P))-(LEN(YLAB$)/2!)
  458. 5270 FOR I=1 TO LEN(YLAB$):YT$=MID$(YLAB$,I,1):LOCATE I+YPOS.P,3:PRINT YT$;:NEXT I
  459. 5280 '
  460. 5290 '  Print label on figure in specified corner
  461. 5300 '
  462. 5310 '
  463. 5320 IF CORNER=0 THEN GOTO 5460
  464. 5330 MAXLEN=0:IF LEN(LAB3$)>MAXLEN THEN MAXLEN=LEN(LAB3$)
  465. 5340 IF LEN(LAB2$)>MAXLEN THEN MAXLEN=LEN(LAB2$)+1
  466. 5350 IF LEN(LAB1$)>MAXLEN THEN MAXLEN=LEN(LAB1$)+1
  467. 5360 IF CORNER=1 OR CORNER=2 THEN XPOS.P=((XLOW.P/XT.P)*80!)+3
  468. 5370 IF CORNER=3 OR CORNER=4 THEN XPOS.P=(((XLOW.P+XRANGE.P)/XT.P)*80!)-MAXLEN
  469. 5380 IF CORNER=2 OR CORNER=4 THEN YPOS.P=((YHI.P/YT.P)*26)+2
  470. 5390 IF CORNER=1 OR CORNER=3 THEN YPOS.P=(((YHI.P+YRANGE.P)/YT.P)*26!)-4!
  471. 5400 LOCATE YPOS.P,XPOS.P:PRINT LAB1$;
  472. 5410 LOCATE YPOS.P+1,XPOS.P:PRINT LAB2$;
  473. 5420 LOCATE YPOS.P+2,XPOS.P:PRINT LAB3$;
  474. 5430 '
  475. 5440 ' tic marks and numbers on linear x axis
  476. 5450 '
  477. 5460 IF XLIN=1 THEN 5640
  478. 5470   FOR XTIC=XMIN.P TO XMAX.P STEP XINC.P
  479. 5480           LINE (XTIC,YMIN.P)-(XTIC,YMIN.P+TICY),1
  480. 5490           LINE (XTIC+XP.P,YMIN.P)-(XTIC+XP.P,YMIN.P+TICY),1
  481. 5500           LINE (XTIC,YMAX.P-TICY)-(XTIC,YMAX.P),1
  482. 5510           LINE (XTIC+XP.P,YMAX.P-TICY)-(XTIC+XP.P,YMAX.P),1
  483. 5520           IF XTIC<XMIN.P+XINC.P THEN 5580
  484. 5530           HALF.P=XTIC-(.5*XINC.P)
  485. 5540           LINE (HALF.P,YMIN.P)-(HALF.P,YMIN.P+(TICY/2)),1
  486. 5550           LINE (HALF.P+XP.P,YMIN.P)-(HALF.P+XP.P,YMIN.P+(TICY/2)),1
  487. 5560           LINE (HALF.P,YMAX.P-(TICY/2))-(HALF.P,YMAX.P),1
  488. 5570           LINE (HALF.P+XP.P,YMAX.P-(TICY/2))-(HALF.P+XP.P,YMAX.P),1
  489. 5580            XPOS.P=(((XLOW.P+(XTIC-XMIN.P))/XT.P)*80!)-(LEN(STR$(XTIC))/2)
  490. 5590           LOCATE 23,XPOS.P:PRINT XTIC;
  491. 5600   NEXT XTIC
  492. 5610 '
  493. 5620 '         tic marks and numbers on linear y axis
  494. 5630 '
  495. 5640 IF YLIN=1 THEN 5820
  496. 5650   FOR YTIC=YMIN.P TO YMAX.P STEP YINC.P
  497. 5660           LINE (XMIN.P,YTIC)-(XMIN.P+TICX,YTIC),1
  498. 5670           LINE (XMAX.P-TICX,YTIC)-(XMAX.P,YTIC),1
  499. 5680           IF YTIC<YMIN.P+YINC.P THEN 5720
  500. 5690           HALF.P=YTIC-(YINC.P/2)
  501. 5700           LINE (XMIN.P,HALF.P)-(XMIN.P+(TICX/2),HALF.P),1
  502. 5710           LINE (XMAX.P-(TICX/2),HALF.P)-(XMAX.P,HALF.P),1
  503. 5720           YPOS.P=((YHI.P+(YMAX.P-YTIC))/YT.P)*26!
  504. 5730            XPOS.P=6-(LEN(STR$(YTIC))/2)
  505. 5740            IF YPOS.P>25 OR YPOS.P<1 THEN BEEP:GOTO 5770
  506. 5750            IF XPOS.P>80 OR XPOS.P<1 THEN BEEP:GOTO 5770
  507. 5760            LOCATE YPOS.P,XPOS.P:PRINT YTIC
  508. 5770   NEXT YTIC
  509. 5780 '
  510. 5790 '         tic marks and numbers on log x axis
  511. 5800 '
  512. 5810 '
  513. 5820 IF XLIN=0 THEN 5980
  514. 5830   FOR CYC=-5 TO 5
  515. 5840           FOR LTIC=1 TO 10
  516. 5850           XTIC=LTIC*(10^CYC)
  517. 5860           LXTIC=LOG(XTIC)/LOG(10)
  518. 5870           IF LXTIC<=XMIN.P OR LXTIC>=XMAX.P THEN 5920
  519. 5880           LINE (LXTIC,YMIN.P)-(LXTIC,YMIN.P+TICY),1
  520. 5890           LINE (LXTIC+XP.P,YMIN.P)-(LXTIC+XP.P,YMIN.P+TICY),1
  521. 5900           LINE (LXTIC,YMAX.P-TICY)-(LXTIC,YMAX.P),1
  522. 5910           LINE (LXTIC+XP.P,YMAX.P-TICY)-(LXTIC+XP.P,YMAX.P),1
  523. 5920           NEXT LTIC
  524. 5930   IF LXTIC>=XMIN.P AND LXTIC<=XMAX.P THEN LOCATE 23,(((XLOW.P+(LXTIC-XMIN.P))/XT.P)*80!)-1:PRINT XTIC;:IF LXTIC+.5<=XMAX.P THEN LOCATE 23,(((XLOW.P+(LXTIC+.5-XMIN.P))/XT.P)*80)-1:PRINT 3!*XTIC;
  525. 5940   NEXT CYC
  526. 5950 '
  527. 5960 '         tic marks and numbers on log y axis
  528. 5970 '
  529. 5980 IF YLIN=0 THEN 6110
  530. 5990   FOR CYC=-5 TO 5
  531. 6000           FOR LTIC=1 TO 10
  532. 6010           YTIC=LTIC*(10^CYC)
  533. 6020           LYTIC=LOG(YTIC)/LOG(10)
  534. 6030           IF LYTIC<=YMIN.P OR LYTIC>=YMAX.P THEN 6060
  535. 6040           LINE (XMIN.P,LYTIC)-(XMIN.P+TICX,LYTIC),1
  536. 6050           LINE (XMAX.P-TICX,LYTIC)-(XMAX.P,LYTIC),1
  537. 6060           NEXT LTIC
  538. 6070  YPOS.P=((YHI.P+(YMAX.P-LYTIC))/YT.P)*26!
  539. 6080  XPOS.P=6-((LEN(STR$(YTIC))/2!))
  540. 6090  IF LYTIC>=YMIN.P AND LYTIC<=YMAX.P AND YPOS.P>=1 THEN LOCATE YPOS.P,XPOS.P:PRINT YTIC;
  541. 6100   NEXT CYC
  542. 6110 '
  543. 6120 '  now plot data on axes
  544. 6130 '
  545. 6140 SX=0:SY=0:SSX=0:SXY=0
  546. 6150 FOR I=1 TO NPTS
  547. 6160    X1(I)=X(I):IF XLIN=1 THEN X1(I)=LOG(X(I))/LOG(10)
  548. 6170    Y1(I)=Y(I):IF YLIN=1 THEN Y1(I)=LOG(Y(I))/LOG(10)
  549. 6180    IF I>1 THEN LINE(X1(I-1),Y1(I-1))-(X1(I),Y1(I)),1,,STYLE
  550. 6190   IF I>1 THEN LINE (X1(I-1)+XP.P,Y1(I-1))-(X1(I)+XP.P,Y1(I)),1,,STYLE
  551. 6200    IF SYM=1 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)+DY),1,B
  552. 6210   IF SYM=1 OR SYM=2 THEN LINE(X1(I)-DX+XP.P,Y1(I)-DY)-(X1(I)+DX+XP.P,Y1(I)+DY),1,B
  553. 6220   IF SYM=2 THEN LINE(X1(I)-DX+XP.P,Y1(I)-DY)-(X1(I)+DX+XP.P,Y1(I)+DY),1,BF
  554. 6230    IF SYM=3 OR SYM=4 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)-DY),1:LINE (X1(I),Y1(I)+DY)-(X1(I)-DX,Y1(I)-DY),1:LINE (X1(I),Y1(I)+DY)-(X1(I)+DX,Y1(I)-DY),1
  555. 6240   IF SYM=3 OR SYM=4 THEN LINE (X1(I)+XP.P,Y1(I)+DY)-(X1(I)+XP.P+DX,Y1(I)-DY),1:LINE (X1(I)+XP.P,Y1(I)+DY)-(X1(I)+XP.P-DX,Y1(I)-DY),1
  556. 6250 IF SYM=4 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1
  557. 6260    IF SYM=5 OR SYM=6 THEN CIRCLE (X1(I),Y1(I)),DX:CIRCLE (X1(I)+XP.P,Y1(I)),DX
  558. 6270 IF SYM=6 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1
  559. 6280    IF SYM=9 THEN LINE (X1(I)-DX,Y1(I)-DY)-(X1(I)+DX,Y1(I)+DY),1:LINE (X1(I)+DX,Y1(I)-DY)-(X1(I)-DX,Y1(I)+DY),1
  560. 6290    IF SYM=7 OR SYM=8 THEN LINE (X1(I),Y1(I)+DY)-(X1(I)+DX,Y1(I)),1:LINE -(X1(I),Y1(I)-DY),1:LINE -(X1(I)-DX,Y1(I)),1:LINE -(X1(I),Y1(I)+DY),1
  561. 6300 IF SYM=8 THEN PAINT (X1(I)+2*XP.P,Y1(I)),1
  562. 6310   SY=SY+Y1(I):SX=SX+X1(I):SSX=SSX+(X1(I)^2):SXY=SXY+(X1(I)*Y1(I))
  563. 6320 NEXT I
  564. 6330 IF LTYPE<>4 THEN RETURN
  565. 6340 '
  566. 6350 ' Regression line plotted
  567. 6360 A=((NPTS*SXY)-(SX*SY))/((NPTS*SSX)-(SX*SX))
  568. 6370 B=(SY/NPTS)-(A*SX/NPTS)
  569. 6380 YMIN.P=(A*XMIN.P)+B:YMAX.P=(A*XMAX.P)+B
  570. 6390 LINE (XMIN.P,YMIN.P)-(XMAX.P,YMAX.P),1
  571. 6400 LINE (XMIN.P+XP.P,YMIN.P)-(XMAX.P+XP.P,YMAX.P),1
  572. 6410 '
  573. 6420 RETURN
  574. 6430 '
  575. 6440 ' key trap of Alt-C to change color
  576. 6450 '
  577. 6460 KLR.P=(KLR.P+1) MOD 128:IF KLR.P MOD 8=0 OR KLR.P MOD 16=0 THEN KLR.P=KLR.P+1
  578. 6470 OUT 985,KLR.P
  579. 6480 RETURN
  580.  
  581.